Prefacio


“La comprensión se utiliza con más frecuencia para tratar de alterar el resultado que para repetirlo o perpetuarlo”

— Jared Diamond

Este documento tiene la finalidad utilizar aprendizaje de máquina para identificar y predecir la frecuencia de factores que condicionan la deserción en la educación media. Toma como eje el trabajo publicado en 2012, denominado “Reporte de la Encuesta Nacional de Deserción en la Educación Media Superior” (ENDEMS) el cual es la única encuesta en este país para intertar entender cuál es la razón de la deserción escolar.

Consiste en 13,014 entrevistas realizadas a 6,472 mujeres y 6,542 hombres, de estas entrevistas 4,770 jóvenes nunca se matricularon en el nivel medio superior y 2,549 desertaron; el resto, 5,686 continúan estudiando o concluyeron este nivel.

Los siguientes son datos generales de la encuesta, sin embargo para el trabajo final se modificaron las variables por lo que el número de encuestas que se utilizaron resultó menor.

Datos Generales de la Encuesta Nacional de Deserción en la Educación Media Superior

Cobertura geográfica.

La cobertura geográfica es representativa a nivel nacional de viviendas particulares en localidades con más de 500 habitantes.

Periodo de referencia.

Del 25 de junio al 30 de julio de 2011.

Población de Interés.

Existen una población de interés y 3 subpoblaciones.

1. Los desertores: aquellos jóvenes que iniciaron la Educación Media Superior y al momento de la entrevista no la habían concluido ni se encontraban realizando estudios para concluir este nivel educativo.

2. Los no desertores: aquellos estudiantes que iniciaron la Educación Media Superior y al momento de la entrevista: a) ya la habían terminaron, o b) no la habían terminado pero seguían estudiando para completarla.

3. Los no matriculados: aquellos jóvenes que al momento de la entrevista no estaban inscritos en la Educación Media Superior, ya sea porque seguían estudiando y todavía no terminaban la secundaria o porque no estaban estudiando y abandonaron sus estudios en algún momento anterior a la media superior.

El tamaño de muestra se fijó en 2,000 desertores, para lo cual se estimó necesario visitar 44,000 viviendas. De esta forma, se aprovechó también el número de visitas para recabar informacíon de jóvenes que nunca se inscribieron a la Educación Media Superior, ya sea porque seguían estudiando la secundaria, porque desertaron del sistema educativo mientras estudiaban la Educación Básica o porque concluyeron ese nivel y no transitaron al siguiente.

El esquema de muestreo fue probabilista, estratificado, por conglomerados y polietáptico. La población objetivo de la ENDEMS estuvo compuesta por jóvenes, hombres y mujeres, de entre 14 y 25 años de edad que residían permanentemente en viviendas particulares ubicadas en localidades con más de 500 habitantes dentro del territorio nacional.

La ENDEMS es la primera encuesta que se levanta en México específicamente sobre deserción en la Educación Media Superior y que es representativa a nivel nacional.

Introducción


Para entender el objeto de este estudio es necesario que demos una descripción muy precisa de lo que es la deserción escolar.

Deserción escolar
“el total de alumnos que abandonan las actividades escolares antes de concluir un grado o nivel educativo”

Es decir, para cuantificar la deserción, se deberá contabilizar a los individuos que ya una vez inscritos en algún grado escolar, abandonan los estudios parcial o completamente. 1

De esta manera la Deserción escolar total se puede calcular como la suma de la deserción intercurricular y la deserción intracurricular.

De manera general para el caso Mexicano se puede observar el siguiente escenario:

De 100 alumnos inscritos en primaria, 60 concluyeron la secundaria, y 36 terminaron el bachillerato.

En términos prácticos un desertor es:

“Aquella persona que inició el grado o el nivel educativo correspondiente, no lo concluyó y no se encuentra realizando estudios para alcanzar dicha conclusión”

Datos ocupados de la ENDEMS


Este apartado carga los datos y examina las principales variables, además recodifica tanto las clases de las diferentes columnas qeu componen el set de datos y otorga las diferentes categorías a las variables

Lo primero que se tuvo que hacer fue modificar la encuesta ya que su unidad básica era el hogar, por ello se tuvieron que trabajar los datos para colocarlos por población objetivo, es decir aquelos jóvenes entre \(18\) y \(25\) años que habían o no deseratado de la educación media superior.

Este punto es relevante porque lo que se quiere es predecir qué jóvenes dejarán de estudiar antes de concluir el bachillerato. Los jóvenes entre 14 y 17 años que están estudiando el bachillerato al momento de la encuesta, no puden catalogarse como no desertores, ya que si bien es cierto que al momento de la encuesta están asistiendo a la preparatoria, eso no quiere decir que al siguiente año vayan a continuar estudiando.

Es por ello que solo se tomaron en cuentas a aquellos individuos que tuvieran entre 18 y 25 años, así como aquellos que desertaron antes de los 17 años.

Al hacer esto nos encotramos con una base de \(8,136\) adolescentes que fueron entrevistados (diferentes a las 13,014 viviendas en las que se había aplicado la encuesta)

#encuesta <- read_dta("./Data/basefinal.dta") 

#source("recodifica.R")

#saveRDS(encuesta, "./Data/encuesta.rds")

encuesta <- readRDS("./Data/encuesta.rds")

encuesta %>% nrow
## [1] 8136

Una vez cargada la encuesta, encontramos que no estaba codificada por ello, tomamos todos los datos y construimos los factores, haciendo más manejable la encuesta, cabe señalar que esta parte del trabajo tomó mucho tiempo ya que se codificaron las variables.

La siguiente es una base filtrada con todos los jóvenes que se entrevistaron y tienen entre 18 y 25 años, edad en la que ya deberían haber terminado la educación media superior, así como aquellos que desertaron con menos de 17 años.

head(encuesta,4) 
## # A tibble: 4 × 64
##   edo    edad sexo   prom_sec secpublica camboesc freqasis     prom_ems reprueba
##   <fct> <int> <fct>     <dbl> <fct>         <dbl> <fct>           <dbl> <fct>   
## 1 Ags      17 mujer       9.6 no                0 siempre asi…      9.2 no      
## 2 Ags      21 hombre      7.6 si                0 faltaba con…      8.5 si      
## 3 Ags      16 hombre      8.3 si                0 asistia reg…      8.5 si      
## 4 Ags      19 hombre      8.1 si                0 asistia reg…      8.5 si      
## # … with 55 more variables: nivelprom <fct>, becado <fct>, p23_1 <fct>,
## #   p23_2 <fct>, p24_1 <fct>, p24_2 <fct>, p24_3 <fct>, p24_4 <fct>,
## #   p24_5 <fct>, p24_6 <fct>, p24_7 <fct>, p24_8 <fct>, p24_9 <fct>,
## #   p24_10 <fct>, p24_11 <fct>, p24_12 <fct>, p24_13 <fct>, p24_14 <fct>,
## #   p24_15 <fct>, p24_16 <fct>, p24_17 <fct>, p24_18 <fct>, p24_19 <fct>,
## #   p24_20 <fct>, p24_21 <fct>, p24_22 <fct>, p24_23 <fct>, trab_est <fct>,
## #   ncuartos <dbl>, p40_1 <fct>, p40_2 <fct>, p40_3 <fct>, p40_4 <fct>, …

Renombrar las variables.

Se cambia el nombre de las variables para darles más significado.

encuesta <- rename(encuesta, 
       edo                     =  edo,
       edad                    =  edad,
       sexo                    =  sexo,
       prom_sec                =  prom_sec,
       sec_publica             =  secpublica,
       cambio_esc              =  camboesc,
       asistencia              =  freqasis,
       p15                     =  prom_ems,
       reprueba                =  reprueba,
       prom_bach               =  nivelprom,
       becado                  =  becado,
       desertor_amigos         =  p23_1, 
       desertor_hermanos       =  p23_2,            
       faltaba_dinero          =  p24_1,    
       prob_turno              =  p24_2,     
       baja_reprueba           =  p24_3,    
       disg_estudiar           =  p24_4,     
       indisciplina            =  p24_5,    
       mejor_trabaja           =  p24_6,     
       no_entiende             =  p24_7, 
       esc_lejos               =  p24_8,     
       cambio_casa             =  p24_9,    
       bulling                 =  p24_10,    
       disciplina_estricta     =  p24_11,   
       discriminado            =  p24_12,    
       prob_familia            =  p24_13,   
       te_casaste              =  p24_14,    
       estudiaran_hermanos     =  p24_15,   
       inseguridad             =  p24_16,    
       fallecio_familiar       =  p24_17,   
       embarazo                =  p24_18,    
       malas_instalaciones     =  p24_19,   
       querias_cambiar_escuela =  p24_20,    
       estudiar_no_sirve       =  p24_21,   
       baja_autoestima         =  p24_22,    
       motivo_otro             =  p24_23,        
       trab_est                =  trab_est,
       ncuartos                =  ncuartos,
       tele                    =  p40_1,        
       dvd                     =  p40_2,    
       refri                   =  p40_3,     
       estufa                  =  p40_4,    
       piso_tierra             =  p40_5,     
       lavadora                =  p40_6,    
       auto                    =  p40_7,     
       microondas              =  p40_8,    
       computadora             =  p40_9,     
       agua                    =  p40_10,   
       telefono                =  p40_11,    
       internet                =  p40_12,   
       excusado                =  p40_13,    
       letrina                 =  p40_14,   
       cable                   =  p40_15,       
       id                      =  id,
       desertor                =  desertor,
       tipo_escuela            =  tipoescuela,
       vive_con                =  pervivia,
       confia_esc              =  p13_esc,
       confia_familia          =  p13_fami,
       confia_amigos           =  p13_amg,
       tabaco                  =  tabaco,   
       alcohol                 =  alcohol,      
       marihuana               =  marihuana,     
       otras_drogas            =  otrasdrog)    

Después de una segunda revisión se decidieron quitar las siguientes variables:

encuesta <- encuesta %>% 
  select(-p15,-baja_reprueba, -indisciplina, -id, -motivo_otro)

Estas variables estaban relacionadas con la variable deserción, por ejemplo la pregunta p15, trataba sobre con cuál promedio de bachillerato te habías dado de baja, así mismo id era solo un indicador que diferiaba a un alumno de otro.

Estadísticos descriptivos del Abandono Escolar

Empezaremos este ejercicio dividiendo nuestra encuesta, en dos set de datos uno para el entrenamiento y otro para la prueba, por ese motivo decidimos separa la base usando un muestreo estratificado debido a que las muestra no es balanceada.

De una muestra total de \(8,136\) encuestados, decidimos guardar \(20\%\) como datos de prueba, siendo \(1,628\) y usar el restante \(80\%\) (\(6,508\)) como datos de entrenamiento, a su vez, separar el 20% de los datos de entrenamiento para usarlos como datos de validación \(1,302\).

Division Total Porcentaje
Prueba 1,628 20%
Entrenamiento 6,508 80%
Total 8,136 100%

Posteriormente la muestra de entrenamiento se subdivide, para crear espacio para la muestra de validación.

Division Total Porcentaje
Entrenamiento 5,206 80%
Validación 1,302 20%
Total 6,508 100%
set.seed(2021)

encuesta_part_inicial <- initial_split(encuesta, strata = desertor, prop = 0.80)
encuesta_total <- training(encuesta_part_inicial)
encuesta_part_val <- validation_split(encuesta_total, prop = 0.80)
encuesta_part_val$splits
## [[1]]
## <Training/Validation/Total>
## <5206/1302/6508>

Limpieza, exploración y análisis conceptual

Primero vamos a establecer que la variable desertor es la que estamos buscando, esta toma dos valores, 1 si el estudiante desertó y 0 si no lo hizo.

Podemos observar que se cuenta con \(42%\) de desertores y \(58%\) no desertores en la encuesta.

set.seed(2021)
entrena <- training(encuesta_part_val$splits[[1]])
nrow(entrena)
## [1] 5206
entrena%>% count(desertor) %>%
  mutate(pcn = round(n / sum(n),2))
## # A tibble: 2 × 3
##   desertor        n   pcn
##   <fct>       <int> <dbl>
## 1 desertor     2167  0.42
## 2 no_desertor  3039  0.58
tabla_univariada <- function(datos, variable, target){
  datos %>% count({{ variable }}, {{ target }}) %>% group_by({{ variable }}) %>% 
  mutate(pcn = round(n / sum(n),2)) }

Resumen general

Variables claramente importantes (hipótesis):

sexo prom_sec cambio_esc asistencia
reprueba prom_bach becado desertor_amigos
desertor_hermanos faltaba_dinero prob_turno disg_estudiar
mejor_trabaja no_entiende cambio_casa bulling
disciplina_estricta discriminado prob_familia te_casaste
estudiaran_hermanos embarazo estudiar_no_sirve baja_autoestima
trab_est ncuartos dvd piso_tierra
auto microondas computadora agua
telefono internet excusado letrina
cable tipo_escuela vive_con confia_esc
confia_familia confia_amigos alcohol

Variables que se eliminarán del modelo:

edo
sec_publica
querias_cambiar_escuela tele
refri
estufa
lavadora
confia_esc
confia_familia
confia_amigos
tabaco
marihuana
otras_drogas


¿Influye la entidad federativa en al que vive?

Podemos observar que etadoe como Ags, BC e Hgo, Tamps, Gro, Q. Roo, Yuc y Zac tienen porcentaje de deserción mayor al 53%. Siendo Ags la entidad com mayor deserción del país.

Eliminamos entidad deferativa porque la encuesta solo es representativa a nivel país.

tabla_univariada(entrena, edo, desertor) %>%   
   ggplot(aes(edo, pcn, fill = desertor)) + 
  geom_col(position = "stack") +  ggtitle("¿Deserciones por entidad?") +
  theme(axis.text.x = element_text(angle = 90))

tabla_univariada(entrena, edo, desertor) %>% filter(desertor == "desertor" & pcn >= .53) %>% arrange(desc(pcn))
## # A tibble: 8 × 4
## # Groups:   edo [8]
##   edo    desertor     n   pcn
##   <fct>  <fct>    <int> <dbl>
## 1 Ags    desertor    62  0.68
## 2 BC     desertor    56  0.55
## 3 Hgo    desertor    53  0.55
## 4 Tamps  desertor    56  0.54
## 5 Gro    desertor    97  0.53
## 6 Q. Roo desertor    61  0.53
## 7 Yuc    desertor   163  0.53
## 8 Zac    desertor    65  0.53

¿El género influye?

En la siguiente tabla puede ver que parecen ser números muy similares, es decir, se observa que mientras el \(43\%\) de los hombres desertan, el \(41\%\) de las mujeres lo hacen.

Incluso pensaría que el porcentaje de mujeres que sería superior pero los datos indican lo cotrario, la tasa de deserción de mujeres es ligeramente menor que la de los hombres.

entrena %>% select(sexo, desertor) %>% 
  group_by(sexo, desertor) %>% 
  tally() %>% mutate(pcn = round(n/sum(n),2)) %>% 
  ggplot(aes(sexo, pcn, fill= desertor)) +  geom_col(position = "dodge") +
  ggtitle("Desertores por sexo")

Promedio Secundaria

Al parecer las personas con un promedio superior a \(8\) en la secundaria tienen \(50\%\) de posibilidades de no desertar en el bachillerato.

tabla_univariada(entrena, prom_sec, desertor) %>%
  ggplot(aes(prom_sec, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("Promedio Secundaria")

entrena %>% select(sexo, desertor,   prom_sec ) %>% group_by(sexo, desertor) %>%
  ggplot(aes(prom_sec, sexo, fill = desertor)) + 
  geom_boxplot() + ggtitle("Promedio Secundaria")

Pública o Privada

Se observa que si la educación es privada la probabilidad de deserción es \(36\%\), mientras que si es pública es \(42\%\).

tabla_univariada(entrena, sec_publica, desertor) %>%
  ggplot(aes(sec_publica, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("Tipo de Secundaria a la que asistió")

Cuántas veces cambiaste de preparatoria

tabla_univariada(entrena, cambio_esc, desertor) %>%
  ggplot(aes(cambio_esc, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("Número de veces que cambiaste de prepa") + xlab("")

¿Qué tanto asistias a tus clases?

Esta variabble es relevante porque muestra un gran cambio en la posibilida de desertar disminuye a medida que aumenta la asitencia a la preparatoria.

tabla_univariada(entrena, asistencia, desertor) %>% 
  ggplot(aes(asistencia, pcn, fill = desertor)) + 
  geom_col(position = "dodge") +  ggtitle("¿Qué tanto faltabas a clase?") +
  scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2), 
                     labels = function(x) stringr::str_wrap(x, width = 20)) + xlab("")

¿Reprobaste alguna materia en la prepa?

Si reprobaste aunque sea una materia tienes el \(50\%\) de posibilidades de desertar.

tabla_univariada(entrena, reprueba, desertor) %>% 
  ggplot(aes(reprueba, pcn, fill = desertor)) + 
  geom_col(position = "dodge") +  ggtitle("¿Reprobaste alguna materia?") +
 xlab("")

¿Cómo consideras que era tu promedio cuando estabas en bachillerato?

Este es un indicador importante, qeu indica que si el joiven considera que tiene un promedio muy bajo existe el \(80\%\) de probailidad de que se de de baja.

tabla_univariada(entrena, prom_bach, desertor) %>% 
  ggplot(aes(prom_bach, pcn, fill = desertor)) + 
  geom_col(position = "dodge") +  ggtitle("¿Como consideras que era tu promedio?") +
  scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2), 
                     labels = function(x) stringr::str_wrap(x, width = 10)) + xlab("")

¿Influye la beca?

Si estabas becado era muy probable que \(73\%\) que no desertaras, comparado con el \(55\%\) si no tenías beca.

tabla_univariada(entrena, becado, desertor) %>% 
  ggplot(aes(becado, pcn, fill = desertor)) + 
  geom_col(position = "dodge") +  ggtitle("¿Estabas becado?") +
  scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2), 
                     labels = function(x) stringr::str_wrap(x, width = 10)) + xlab("")

¿Tuviste amigos o hermanos que desertaron?

La variable más importante es si tuviste hermanos que desertaron ya que tu probabilidad de desertar es del \(56\%\) en cambio si tienes hermanos que desertaron tu probabilida de desertar es del \(44\%\).

tabla_univariada(entrena, desertor_amigos, desertor)
## # A tibble: 4 × 4
## # Groups:   desertor_amigos [2]
##   desertor_amigos desertor        n   pcn
##   <fct>           <fct>       <int> <dbl>
## 1 si              desertor     1124  0.44
## 2 si              no_desertor  1420  0.56
## 3 no              desertor     1043  0.39
## 4 no              no_desertor  1619  0.61
tabla_univariada(entrena, desertor_hermanos, desertor)
## # A tibble: 4 × 4
## # Groups:   desertor_hermanos [2]
##   desertor_hermanos desertor        n   pcn
##   <fct>             <fct>       <int> <dbl>
## 1 si                desertor      392  0.56
## 2 si                no_desertor   306  0.44
## 3 no                desertor     1775  0.39
## 4 no                no_desertor  2733  0.61

Ahora tenemos una serie de variables en las que preguntan sobre la situación en su casa

A continuación veremos las siguientes variables: faltaba_dinero prob_turno baja_reprueba
disg_estudiar indisciplina mejor_trabaja
no_entiende esc_lejos cambio_casa
bulling disciplina_estricta discriminado
prob_familia te_casate estudiaran_hermanos
inseguridad fallecio_familiar embarazo
malas_instalaciones querias_cambiar_escuela estudiar_no_sirve
baja_autoestima

De estas las que están más fuertemente relacionadas con la deserción son: * le disgusta estudiar(\(68\%\)) * mejor prefiere trabajar(\(72\%\)) * te casaste (\(77\%\)) * embarazo (\(76\%\)) * estudiar no sirve (\(72\%\)) * baja autoestima (\(64\%\)) * discriminado (\(58\%\)) * problemas en la familia (\(58\%\)) * estudiaran hermanos (\(59\%\))

tabla_univariada(entrena, faltaba_dinero, desertor)
## # A tibble: 4 × 4
## # Groups:   faltaba_dinero [2]
##   faltaba_dinero desertor        n   pcn
##   <fct>          <fct>       <int> <dbl>
## 1 si             desertor     1332  0.5 
## 2 si             no_desertor  1312  0.5 
## 3 no             desertor      835  0.33
## 4 no             no_desertor  1727  0.67
tabla_univariada(entrena, prob_turno, desertor)
## # A tibble: 4 × 4
## # Groups:   prob_turno [2]
##   prob_turno desertor        n   pcn
##   <fct>      <fct>       <int> <dbl>
## 1 si         desertor      344  0.47
## 2 si         no_desertor   386  0.53
## 3 no         desertor     1823  0.41
## 4 no         no_desertor  2653  0.59
tabla_univariada(entrena, mejor_trabaja, desertor)
## # A tibble: 4 × 4
## # Groups:   mejor_trabaja [2]
##   mejor_trabaja desertor        n   pcn
##   <fct>         <fct>       <int> <dbl>
## 1 si menciono   desertor      586  0.72
## 2 si menciono   no_desertor   225  0.28
## 3 no menciono   desertor     1581  0.36
## 4 no menciono   no_desertor  2814  0.64
tabla_univariada(entrena, no_entiende, desertor)
## # A tibble: 4 × 4
## # Groups:   no_entiende [2]
##   no_entiende desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si menciono desertor      664  0.55
## 2 si menciono no_desertor   536  0.45
## 3 no menciono desertor     1503  0.38
## 4 no menciono no_desertor  2503  0.62
tabla_univariada(entrena, esc_lejos, desertor)
## # A tibble: 4 × 4
## # Groups:   esc_lejos [2]
##   esc_lejos   desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si menciono desertor      367  0.43
## 2 si menciono no_desertor   479  0.57
## 3 no menciono desertor     1800  0.41
## 4 no menciono no_desertor  2560  0.59
tabla_univariada(entrena, cambio_casa, desertor)
## # A tibble: 4 × 4
## # Groups:   cambio_casa [2]
##   cambio_casa desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si menciono desertor      164  0.48
## 2 si menciono no_desertor   180  0.52
## 3 no menciono desertor     2003  0.41
## 4 no menciono no_desertor  2859  0.59
tabla_univariada(entrena, bulling, desertor)
## # A tibble: 4 × 4
## # Groups:   bulling [2]
##   bulling     desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si menciono desertor      298  0.48
## 2 si menciono no_desertor   324  0.52
## 3 no menciono desertor     1869  0.41
## 4 no menciono no_desertor  2715  0.59
tabla_univariada(entrena, disciplina_estricta, desertor)
## # A tibble: 4 × 4
## # Groups:   disciplina_estricta [2]
##   disciplina_estricta desertor        n   pcn
##   <fct>               <fct>       <int> <dbl>
## 1 si menciono         desertor      453  0.43
## 2 si menciono         no_desertor   606  0.57
## 3 no menciono         desertor     1714  0.41
## 4 no menciono         no_desertor  2433  0.59
tabla_univariada(entrena, discriminado, desertor)
## # A tibble: 4 × 4
## # Groups:   discriminado [2]
##   discriminado desertor        n   pcn
##   <fct>        <fct>       <int> <dbl>
## 1 si menciono  desertor      187  0.58
## 2 si menciono  no_desertor   133  0.42
## 3 no menciono  desertor     1980  0.41
## 4 no menciono  no_desertor  2906  0.59
tabla_univariada(entrena, prob_familia, desertor)
## # A tibble: 4 × 4
## # Groups:   prob_familia [2]
##   prob_familia desertor        n   pcn
##   <fct>        <fct>       <int> <dbl>
## 1 si menciono  desertor      300  0.58
## 2 si menciono  no_desertor   217  0.42
## 3 no menciono  desertor     1867  0.4 
## 4 no menciono  no_desertor  2822  0.6
tabla_univariada(entrena, estudiaran_hermanos, desertor)
## # A tibble: 4 × 4
## # Groups:   estudiaran_hermanos [2]
##   estudiaran_hermanos desertor        n   pcn
##   <fct>               <fct>       <int> <dbl>
## 1 si menciono         desertor      118  0.59
## 2 si menciono         no_desertor    82  0.41
## 3 no menciono         desertor     2049  0.41
## 4 no menciono         no_desertor  2957  0.59
tabla_univariada(entrena, inseguridad, desertor)
## # A tibble: 4 × 4
## # Groups:   inseguridad [2]
##   inseguridad desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si menciono desertor      177  0.39
## 2 si menciono no_desertor   274  0.61
## 3 no menciono desertor     1990  0.42
## 4 no menciono no_desertor  2765  0.58
tabla_univariada(entrena, fallecio_familiar, desertor)
## # A tibble: 4 × 4
## # Groups:   fallecio_familiar [2]
##   fallecio_familiar desertor        n   pcn
##   <fct>             <fct>       <int> <dbl>
## 1 si menciono       desertor      217  0.37
## 2 si menciono       no_desertor   362  0.63
## 3 no menciono       desertor     1950  0.42
## 4 no menciono       no_desertor  2677  0.58
tabla_univariada(entrena, malas_instalaciones, desertor)
## # A tibble: 4 × 4
## # Groups:   malas_instalaciones [2]
##   malas_instalaciones desertor        n   pcn
##   <fct>               <fct>       <int> <dbl>
## 1 si menciono         desertor      195  0.42
## 2 si menciono         no_desertor   266  0.58
## 3 no menciono         desertor     1972  0.42
## 4 no menciono         no_desertor  2773  0.58
tabla_univariada(entrena, querias_cambiar_escuela, desertor)
## # A tibble: 4 × 4
## # Groups:   querias_cambiar_escuela [2]
##   querias_cambiar_escuela desertor        n   pcn
##   <fct>                   <fct>       <int> <dbl>
## 1 si menciono             desertor      161  0.62
## 2 si menciono             no_desertor    99  0.38
## 3 no menciono             desertor     2006  0.41
## 4 no menciono             no_desertor  2940  0.59
tabla_univariada(entrena,estudiar_no_sirve, desertor)
## # A tibble: 4 × 4
## # Groups:   estudiar_no_sirve [2]
##   estudiar_no_sirve desertor        n   pcn
##   <fct>             <fct>       <int> <dbl>
## 1 si menciono       desertor      163  0.72
## 2 si menciono       no_desertor    63  0.28
## 3 no menciono       desertor     2004  0.4 
## 4 no menciono       no_desertor  2976  0.6
tabla_univariada(entrena, baja_autoestima, desertor)
## # A tibble: 4 × 4
## # Groups:   baja_autoestima [2]
##   baja_autoestima desertor        n   pcn
##   <fct>           <fct>       <int> <dbl>
## 1 si menciono     desertor      197  0.64
## 2 si menciono     no_desertor   109  0.36
## 3 no menciono     desertor     1970  0.4 
## 4 no menciono     no_desertor  2930  0.6
tabla_univariada(entrena, te_casaste, desertor) %>% ggplot(aes(te_casaste, pcn, fill = desertor)) + geom_col(position ="dodge") + ggtitle("Te casate")

tabla_univariada(entrena, embarazo, desertor) %>% ggplot(aes(embarazo, pcn, fill = desertor)) + geom_col(position ="dodge") +  ggtitle("Te embarazaste")

tabla_univariada(entrena, disg_estudiar, desertor) %>% ggplot(aes(disg_estudiar, pcn, fill = desertor)) + geom_col(position ="dodge") +  ggtitle("Te disgusta estudiar")

¿Trabajaba mientras estudiaba?

Mo parece ser una variable relevante

tabla_univariada(entrena, trab_est , desertor) %>% 
  ggplot(aes(trab_est , pcn, fill = desertor)) + 
  geom_col(position = "dodge") +  ggtitle("¿Trabaja mientras estudia?") +
 xlab("")

¿Cuántos cuartos tiene tu casa?

Al aumentar el número de cuartos aumenta la probabilidad de terminar el bachillerato.

tabla_univariada(entrena, ncuartos, desertor) %>% ggplot(aes(factor(ncuartos), pcn, fill = desertor)) + geom_col(position = "dodge") + ggtitle("¿Cuántos cuartos tiene su casa?") +
 xlab("")

tabla_univariada(entrena, ncuartos, desertor) %>% ggplot(aes(ncuartos, fill = desertor)) + geom_boxplot() + ggtitle("¿Cuántos cuartos tiene su casa?") +
 xlab("")

¿En su casa cuenta con lo siguiente?

tabla_univariada(entrena, tele, desertor)
## # A tibble: 4 × 4
## # Groups:   tele [2]
##   tele  desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor     2089  0.41
## 2 si    no_desertor  2992  0.59
## 3 no    desertor       78  0.62
## 4 no    no_desertor    47  0.38
tabla_univariada(entrena, dvd, desertor)
## # A tibble: 4 × 4
## # Groups:   dvd [2]
##   dvd   desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor     1555  0.39
## 2 si    no_desertor  2463  0.61
## 3 no    desertor      612  0.52
## 4 no    no_desertor   576  0.48
tabla_univariada(entrena, refri, desertor)
## # A tibble: 4 × 4
## # Groups:   refri [2]
##   refri desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor     1958  0.4 
## 2 si    no_desertor  2877  0.6 
## 3 no    desertor      209  0.56
## 4 no    no_desertor   162  0.44
tabla_univariada(entrena, estufa, desertor)
## # A tibble: 4 × 4
## # Groups:   estufa [2]
##   estufa desertor        n   pcn
##   <fct>  <fct>       <int> <dbl>
## 1 si     desertor     2021  0.41
## 2 si     no_desertor  2939  0.59
## 3 no     desertor      146  0.59
## 4 no     no_desertor   100  0.41
tabla_univariada(entrena, piso_tierra, desertor)
## # A tibble: 4 × 4
## # Groups:   piso_tierra [2]
##   piso_tierra desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si          desertor      319  0.46
## 2 si          no_desertor   382  0.54
## 3 no          desertor     1848  0.41
## 4 no          no_desertor  2657  0.59
tabla_univariada(entrena, lavadora, desertor)
## # A tibble: 4 × 4
## # Groups:   lavadora [2]
##   lavadora desertor        n   pcn
##   <fct>    <fct>       <int> <dbl>
## 1 si       desertor     1569  0.39
## 2 si       no_desertor  2408  0.61
## 3 no       desertor      598  0.49
## 4 no       no_desertor   631  0.51
tabla_univariada(entrena, auto, desertor)
## # A tibble: 4 × 4
## # Groups:   auto [2]
##   auto  desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor      634  0.33
## 2 si    no_desertor  1286  0.67
## 3 no    desertor     1533  0.47
## 4 no    no_desertor  1753  0.53
tabla_univariada(entrena, microondas, desertor)
## # A tibble: 4 × 4
## # Groups:   microondas [2]
##   microondas desertor        n   pcn
##   <fct>      <fct>       <int> <dbl>
## 1 si         desertor     1024  0.36
## 2 si         no_desertor  1859  0.64
## 3 no         desertor     1143  0.49
## 4 no         no_desertor  1180  0.51
tabla_univariada(entrena, computadora, desertor)
## # A tibble: 4 × 4
## # Groups:   computadora [2]
##   computadora desertor        n   pcn
##   <fct>       <fct>       <int> <dbl>
## 1 si          desertor      662  0.29
## 2 si          no_desertor  1631  0.71
## 3 no          desertor     1505  0.52
## 4 no          no_desertor  1408  0.48
tabla_univariada(entrena, agua, desertor)
## # A tibble: 4 × 4
## # Groups:   agua [2]
##   agua  desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor     1908  0.41
## 2 si    no_desertor  2783  0.59
## 3 no    desertor      259  0.5 
## 4 no    no_desertor   256  0.5
tabla_univariada(entrena, telefono, desertor)
## # A tibble: 4 × 4
## # Groups:   telefono [2]
##   telefono desertor        n   pcn
##   <fct>    <fct>       <int> <dbl>
## 1 si       desertor      932  0.33
## 2 si       no_desertor  1888  0.67
## 3 no       desertor     1235  0.52
## 4 no       no_desertor  1151  0.48
tabla_univariada(entrena, internet, desertor)
## # A tibble: 4 × 4
## # Groups:   internet [2]
##   internet desertor        n   pcn
##   <fct>    <fct>       <int> <dbl>
## 1 si       desertor      507  0.28
## 2 si       no_desertor  1306  0.72
## 3 no       desertor     1660  0.49
## 4 no       no_desertor  1733  0.51
tabla_univariada(entrena, excusado, desertor)
## # A tibble: 4 × 4
## # Groups:   excusado [2]
##   excusado desertor        n   pcn
##   <fct>    <fct>       <int> <dbl>
## 1 si       desertor     1900  0.41
## 2 si       no_desertor  2772  0.59
## 3 no       desertor      267  0.5 
## 4 no       no_desertor   267  0.5
tabla_univariada(entrena, letrina, desertor)
## # A tibble: 4 × 4
## # Groups:   letrina [2]
##   letrina desertor        n   pcn
##   <fct>   <fct>       <int> <dbl>
## 1 si      desertor      339  0.44
## 2 si      no_desertor   425  0.56
## 3 no      desertor     1828  0.41
## 4 no      no_desertor  2614  0.59
tabla_univariada(entrena, cable, desertor)
## # A tibble: 4 × 4
## # Groups:   cable [2]
##   cable desertor        n   pcn
##   <fct> <fct>       <int> <dbl>
## 1 si    desertor      715  0.34
## 2 si    no_desertor  1398  0.66
## 3 no    desertor     1452  0.47
## 4 no    no_desertor  1641  0.53

¿En qué tipo de prepa estudiaste la preparatoria?

tabla_univariada(entrena, tipo_escuela, desertor) %>% 
  ggplot(aes(tipo_escuela, pcn, fill = desertor)) + 
  geom_col(position = "stack") +  ggtitle("¿En qué tipo de escuela estudiaste la prepa") +
 xlab("") +   theme(axis.text.x = element_text(angle = 90))

¿Con quien vives?

No parece ser una varaible relevante, ya que los porcentajes de desrción se ven muy similares en todos los casos

tabla_univariada(entrena, vive_con, desertor) %>%
  ggplot(aes(vive_con, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿Con quien vives")

¿Si tiene problemas en el bachillerato confiaba en la escuela, la familia o los amigos?

Realmente la probabilidad de desertar aumenta si no confias en al escuela o la familia.

tabla_univariada(entrena, confia_esc, desertor) %>%
  ggplot(aes(confia_esc, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿confias en la escuela?")

tabla_univariada(entrena, confia_familia, desertor) %>%
  ggplot(aes(confia_familia, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿confias en la familia?")

tabla_univariada(entrena, confia_amigos, desertor) %>%
  ggplot(aes(confia_amigos, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿confias en los amigos?")

¿Consumes alguan de las siguientes sustancias?

tabaco
alcohol
marihuana
otras_drogas

tabla_univariada(entrena, tabaco, desertor) %>%
  ggplot(aes(tabaco, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿Consumes tabaco?")

tabla_univariada(entrena, alcohol, desertor) %>%
  ggplot(aes(alcohol, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿Consumes alcohol?")

tabla_univariada(entrena, marihuana, desertor) %>%
  ggplot(aes(marihuana, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿Consumes marihuana?")

tabla_univariada(entrena, otras_drogas, desertor) %>%
  ggplot(aes(otras_drogas, pcn, fill = desertor)) + 
  geom_col(position = "dodge") + ggtitle("¿otras drogas?")

Preprocesamiento e ingenieria de entradas:

Usaremos una receta más simple (no necesariamente tenemos que poner interacciones, categorización de entradas, transformaciones no lineales):

receta <-   recipe(desertor ~ 
                            sexo                    +
                            prom_sec                +
                            cambio_esc              +
                            asistencia              +
                            reprueba                +
                            prom_bach               +
                            becado                  +
                            desertor_amigos         +
                            desertor_hermanos       +
                            faltaba_dinero          +
                            prob_turno              +
                            disg_estudiar           +
                            mejor_trabaja           +
                            no_entiende             +
                            cambio_casa             +
                            bulling                 +
                            disciplina_estricta     +
                            discriminado            +
                            prob_familia            +
                            te_casaste              +
                            estudiaran_hermanos     +
                            embarazo                +
                            estudiar_no_sirve       +
                            baja_autoestima         +
                            trab_est                +
                            ncuartos                +
                            dvd                     +
                            piso_tierra             +
                            auto                    +
                            microondas              +
                            computadora             +
                            agua                    +
                            telefono                +
                            internet                +
                            excusado                +
                            letrina                 +
                            cable                   +
                            tipo_escuela            +
                            vive_con                +
                            confia_esc              +
                            confia_familia          +
                            confia_amigos           +
                            alcohol,                 
                       data = entrena) %>%
  step_dummy(all_nominal_predictors()) %>%
  step_zv(all_predictors()) #step_zv  remove variables that contain only a single value.

Dimensión de los datos:

prep(receta, entrena) %>% juice() %>% dim()
## [1] 5206   61

Empezamos con parámetros más o menos default

modelo_boosting <- boost_tree(learn_rate = 0.01, trees = 3000, 
                              mtry = 5, tree_depth = 7, sample_size = 0.8) %>%
  set_mode("classification") %>% 
  set_args(objective = "binary:logistic")
flujo <- workflow() %>% add_recipe(receta) %>% add_model(modelo_boosting)
flujo_fit <- fit(flujo, entrena)
## [18:02:30] WARNING: amalgamation/../src/learner.cc:1115: Starting in XGBoost 1.3.0, the default evaluation metric used with the objective 'binary:logistic' was changed from 'error' to 'logloss'. Explicitly set eval_metric if you'd like to restore the old behavior.
ajuste_xgboost <- flujo_fit %>% extract_fit_engine() %>% pluck("evaluation_log") %>%
  as_tibble()
ggplot(ajuste_xgboost, aes(x=iter, y = training_logloss)) + geom_line()

valida <- testing(encuesta_part_val$splits[[1]])
preds_val <- predict(flujo_fit, valida, type = "prob") %>% 
  bind_cols(valida %>% select(desertor))
mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_val, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first")
## # A tibble: 2 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 mn_log_loss binary         0.422
## 2 roc_auc     binary         0.885
preds_entrena <- predict(flujo_fit, entrena, type = "prob") %>% 
  bind_cols(entrena %>% select(desertor))
mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_entrena, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first")
## # A tibble: 2 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 mn_log_loss binary         0.201
## 2 roc_auc     binary         0.990
ggplot(preds_val, aes(x = .pred_desertor, fill = factor(desertor))) +   geom_histogram(alpha=0.8)

Preparar solución

La siguiente es la solución al problema que estamos planteando.

encuesta_test  <-  testing(encuesta_part_inicial)

preds_prueba_sol <- predict(flujo_fit, encuesta_test, type="prob") %>% 
  bind_cols(encuesta_test %>% select(desertor)) 
 
mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_prueba_sol, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first") 
## # A tibble: 2 × 3
##   .metric     .estimator .estimate
##   <chr>       <chr>          <dbl>
## 1 mn_log_loss binary         0.392
## 2 roc_auc     binary         0.901

Resultados:

  1. Esto modelo logra un score de \(0.3919\)
  2. Una curva ROC de \(.9010\)
roc_graf <- roc_curve(preds_prueba_sol, truth = factor(desertor), .pred_desertor,event_level = "first")

autoplot(roc_graf)

Interpretación del Modelo

Como se menciona en las notas del curso, Clase 15 Interpretación de modelos, buscamos responder ¿Cuánto contribuye cada variable al desempeño predictivo del modelo?. Para dar respuesta a esta pregunta se recurre a la idea de importancia basadas en permutaciones. En la cual se realiza el ajuste del modelo con un conjunto de entrenamiento y se toma un conjunto de datos de validación. En cada variable del modelo se realiza lo siguiente:

  1. Permutamos la variable en el conjunto de validación
  2. Hacemos predicciones con nuestro predictor
  3. Evaluamos el error de predicción
  4. Obtenemos la diferencia del error de predicción con las variables no permutadas A esta diferencia le llamamos importancia de la variable bajo el método de permutaciones.
pred_iml <- function(model, newdata){
   predict(model, new_data = newdata) %>% pull(.pred_class)
}

predictor <- Predictor$new(model = flujo_fit, data = encuesta_test,
                           y = "desertor", predict.fun = pred_iml)
vars_usadas <- extract_preprocessor(flujo_fit) %>% pluck("var_info") %>%
  filter(role == "predictor") %>%
  pull(variable)

imp_boosting <- FeatureImp$new(predictor, loss = "ce",  
                             compare = "difference", n.repetitions = 5, features = vars_usadas)

importancias <- imp_boosting$results %>% 
    mutate(feature = fct_reorder(feature, importance))

 ggplot(importancias, aes(x = feature, y = importance)) +
    geom_hline(yintercept = 0, colour = "salmon") +
    geom_point() + coord_flip()

Conclusión

Podemos observar que el modelo es bueno para predecir la deserción escolar, teniendo una pérdida logarítmicade \(0.3890\) y una curva ROC de \(.9035\), adicionalmente podemos observar la importancia de las varaibles, la cual es la siguiente.

  • Promedio bachillerato
  • Embarazo
  • Le disgusta estudiar
  • Se casó
  • Mejor trabaja
  • Tipo de escuela
  • prom_secundaria
  • número de cuartos en suc casa.
  • asitencia al bachillerato
  • faltaba dinero

  1. Lineamientos para la elaboración de indicadores educativos↩︎